home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MENU_UTL / MENUUN / MENUS.PAS < prev   
Pascal/Delphi Source File  |  1994-12-17  |  7KB  |  227 lines
  1. Unit Menus;
  2. {This unit provides a standardized menu system.}
  3.  
  4. Interface
  5. Uses Crt;
  6.  
  7. Type
  8.     MenuLineType = String[25];
  9.     MenuArryType = Array[1..25] of MenuLineType;
  10.     MenuRec      = Record
  11.         MenuArray  : MenuArryType;
  12.         NbrEntries : Integer;
  13.     End; {MenuRec}
  14.  
  15.     LocationRec = Record
  16.         Col : Integer;
  17.         Row : Integer;
  18.     End;
  19.  
  20.     ScreenLocation = (NW, N, NE, W, C, E, SW, S, SE);
  21.  
  22. Procedure CreateMenu (Var Menu : MenuRec);
  23. {Initializes the menu to empty before starting a new menu}
  24.  
  25. Procedure AddToMenu (Var Menu : MenuRec;
  26.                          NewEntry : MenuLineType);
  27. {Adds a new line entry to the menu being built}
  28.  
  29. Procedure ShowMenu (Var Menu     : MenuRec;
  30.                         Position : ScreenLocation;
  31.                     Var ItemSelected : Integer);
  32. {Displays the current menu on the screen at the location defined by
  33. Position}
  34.  
  35. Procedure ChangeMenuColors (Border, Background, Foreground, SelectBack,
  36.                             SelectFore : Integer);
  37. {Sets the colors used in the menu}
  38.  
  39. Implementation
  40. Type
  41.     MenuColorRec = Record
  42.         MenuBorder : Integer;
  43.         MenuBackGnd : Integer;
  44.         MenuForeGnd : Integer;
  45.         MenuSelectBack : Integer;
  46.         MenuSelectFore : Integer;
  47.     End;
  48.  
  49. Var
  50.     MenuColor : MenuColorRec;
  51.  
  52. Function RowWidth (Var Menu : MenuRec): Integer;
  53. Var
  54.     ix, wide : integer;
  55. Begin
  56.     wide := 0;
  57.     For ix := 1 to Menu.NbrEntries Do
  58.         If Length(Menu.MenuArray[ix]) > wide Then
  59.             wide := Length(Menu.MenuArray[ix]);
  60.     RowWidth := wide;
  61. End;
  62.  
  63. Procedure FindPosition (Var Menu     : MenuRec;
  64.                             Position : ScreenLocation;
  65.                         Var LocOut   : LocationRec);
  66. {This function calculates the beginning position for the first line as
  67.  a column and a row.}
  68.  
  69. Var
  70.     ix : Integer;
  71. Begin
  72.     Case Position of
  73.       NW : Begin
  74.              LocOut.Col := 2;
  75.              LocOut.Row := 2;
  76.            End;
  77.       N  : Begin
  78.              LocOut.Col := 39 - RowWidth(Menu) Div 2;
  79.              LocOut.Row := 2;
  80.            End;
  81.       NE : Begin
  82.              LocOut.Col := 79 - RowWidth(Menu);
  83.              LocOut.Row := 2;
  84.            End;
  85.       W  : Begin
  86.              LocOut.Col := 2;
  87.              LocOut.Row := 12 - Menu.NbrEntries Div 2;
  88.            End;
  89.       C  : Begin
  90.              LocOut.Col := 39 - RowWidth(Menu) Div 2;
  91.              LocOut.Row := 12 - Menu.NbrEntries Div 2;
  92.            End;
  93.       E  : Begin
  94.              LocOut.Col := 79 - RowWidth(Menu);
  95.              LocOut.Row := 11 - Menu.NbrEntries Div 2;
  96.            End;
  97.       SW : Begin
  98.              LocOut.Col := 2;
  99.              LocOut.Row := 25 - Menu.NbrEntries;
  100.            End;
  101.       S  : Begin
  102.              LocOut.Col := 39 - RowWidth(Menu) Div 2;
  103.              LocOut.Row := 25 - Menu.NbrEntries;
  104.            End;
  105.       SE : Begin
  106.              LocOut.Col := 79 - RowWidth(Menu);
  107.              LocOut.Row := 25 - Menu.NbrEntries;
  108.            End;
  109.     End; {Case}
  110. End;
  111.  
  112. Procedure CreateMenu (Var Menu : MenuRec);
  113. {Initializes the menu to empty before starting a new menu}
  114. Begin
  115.     Menu.NbrEntries := 0;
  116.     MenuColor.MenuBorder := Yellow;
  117.     MenuColor.MenuBackGnd := Lightgray;
  118.     MenuColor.MenuForeGnd := Black;
  119.     MenuColor.MenuSelectBack := Cyan;
  120.     MenuColor.MenuSelectFore := Blue;
  121. End;
  122.  
  123. Procedure AddToMenu (Var Menu : MenuRec;
  124.                          NewEntry : MenuLineType);
  125. {Adds a new line entry to the menu being built}
  126. Begin
  127.     inc(Menu.NbrEntries);
  128.     Menu.MenuArray[Menu.NbrEntries] := NewEntry;
  129. End;
  130.  
  131. Procedure ShowMenu (Var Menu : MenuRec;
  132.                         Position : ScreenLocation;
  133.                     Var ItemSelected : Integer);
  134. Var
  135.     CurrPosition,
  136.     HoldPosition : LocationRec;
  137.     ix, wide     : Integer;
  138.     Ch           : Char;
  139. {Displays the current menu on the screen at the location defined by
  140. Position}
  141.  
  142. Begin
  143.          ClrScr;
  144.          FindPosition(Menu, Position, CurrPosition);
  145.          HoldPosition := CurrPosition;
  146.          TextBackGround(MenuColor.MenuBackGnd);
  147.          TextColor(MenuColor.MenuForeGnd);
  148.          ItemSelected := 1;
  149.          GoToXY(CurrPosition.Col, CurrPosition.Row - 1);
  150.          TextBackGround (MenuColor.MenuBorder);
  151.          wide := RowWidth(Menu);
  152.          for ix := 1 to wide + 1 Do
  153.              Write(' ');
  154.          While ItemSelected <= Menu.NbrEntries Do
  155.          Begin
  156.              GoToXY(CurrPosition.Col - 1, CurrPosition.Row);
  157.              TextBackGround (MenuColor.MenuBorder);
  158.              Write (' ');
  159.              TextBackGround (MenuColor.MenuBackGnd);
  160.              Write (Menu.MenuArray[ItemSelected]);
  161.              For ix := Length(Menu.MenuArray[ItemSelected]) to wide Do
  162.                  Write(' ');
  163.              TextBackGround (MenuColor.MenuBorder);
  164.              Write (' ');
  165.              Inc(CurrPosition.Row);
  166.              Inc(ItemSelected);
  167.          End;
  168.          GoToXY(CurrPosition.Col, CurrPosition.Row);
  169.          TextBackGround (MenuColor.MenuBorder);
  170.          for ix := 1 to wide + 1 Do
  171.              Write(' ');
  172.          ItemSelected := 1;
  173.          CurrPosition.Row := HoldPosition.Row;
  174.          Repeat
  175.              GoToXY(CurrPosition.Col, CurrPosition.Row);
  176.              TextBackground (MenuColor.MenuSelectBack);
  177.              TextColor (MenuColor.MenuSelectFore);
  178.              Write (Menu.MenuArray[ItemSelected]);
  179.              For ix := Length(Menu.MenuArray[ItemSelected]) to wide Do
  180.                  Write (' ');
  181.              Ch := Readkey;
  182.              TextBackGround (MenuColor.MenuBackGnd);
  183.              TextColor (MenuColor.MenuForeGnd);
  184.              if Ch = #0 Then
  185.              Begin
  186.                  Ch := ReadKey;
  187.                  GoToXY(CurrPosition.Col, CurrPosition.Row);
  188.                  Write (Menu.MenuArray[ItemSelected]);
  189.                  For ix := Length(Menu.MenuArray[ItemSelected]) to wide Do
  190.                      Write (' ');
  191.                  Case Ch of
  192.                  #80 : Begin
  193.                        Inc(CurrPosition.Row);
  194.                        Inc(ItemSelected);
  195.                        If ItemSelected > Menu.NbrEntries Then
  196.                        Begin
  197.                           ItemSelected := 1;
  198.                           CurrPosition.Row := HoldPosition.Row;
  199.                          End;
  200.                        End;
  201.                  #72  : Begin
  202.                        Dec(CurrPosition.Row);
  203.                        Dec(ItemSelected);
  204.                        If ItemSelected < 1 Then
  205.                        Begin
  206.                           CurrPosition.Row := Menu.NbrEntries + HoldPosition.Row
  207.                            - 1;
  208.                           ItemSelected := Menu.NbrEntries;
  209.                          End;
  210.                        End;
  211.                   End;
  212.              End;
  213.          Until (Ch = #27) or (Ch = #13);
  214. End;
  215.  
  216. Procedure ChangeMenuColors (Border, Background, Foreground, SelectBack,
  217.                             SelectFore : Integer);
  218. {Sets the colors used in the menu}
  219. Begin
  220.     MenuColor.MenuBorder := Border;
  221.     MenuColor.MenuBackGnd := Background;
  222.     MenuColor.MenuForeGnd := Foreground;
  223.     MenuColor.MenuSelectBack := SelectBack;
  224.     MenuColor.MenuSelectFore := SelectFore;
  225. End;
  226.  
  227. End.